Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH8/SRC/SIERP.FRM

Visual Basic Form | 1996-03-07 | 5.9 KB | 192 lines

VERSION 4.00
Begin VB.Form SierpForm
   Caption         =   "Sierpinski"
   ClientHeight    =   4335
   ClientLeft      =   2280
   ClientTop       =   1185
   ClientWidth     =   5070
   Height          =   5025
   Left            =   2220
   LinkTopic       =   "Form1"
   ScaleHeight     =   289
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   338
   Top             =   555
   Width           =   5190
   Begin VB.TextBox LevelText
      Height          =   285
      Left            =   600
      MaxLength       =   3
      TabIndex        =   0
      Text            =   "5"
      Top             =   0
      Width           =   375
   End
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      Height          =   4335
      Left            =   1080
      ScaleHeight     =   285
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   261
      TabIndex        =   3
      Top             =   0
      Width           =   3975
   End
   Begin VB.CommandButton CmdGo
      Caption         =   "Go"
      Default         =   -1  'True
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   480
      Width           =   735
   End
   Begin VB.Label Label1
      Caption         =   "Level"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   495
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "SierpForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim TheLevel As Integer
Dim StartLength As Single
' Maximum space the curve can take up.
Dim TotalLength As Integer
Dim StartX As Integer
Dim StartY As Integer
' ************************************************
' Draw the complete Sierpinski curve.
' ************************************************
Sub Sierpinski(level As Integer, Dist As Single)
    SierpB level, Dist
    Canvas.Line -Step(Dist, Dist)
    SierpC level, Dist
    Canvas.Line -Step(Dist, -Dist)
    SierpD level, Dist
    Canvas.Line -Step(-Dist, -Dist)
    SierpA level, Dist
    Canvas.Line -Step(-Dist, Dist)
End Sub
' ************************************************
' Draw a type B sierpinski sub-curve.
' ************************************************
Sub SierpB(level As Integer, Dist As Single)
    If level = 1 Then
        Canvas.Line -Step(Dist, Dist)
        Canvas.Line -Step(0, Dist)
        Canvas.Line -Step(-Dist, Dist)
    Else
        SierpB level - 1, Dist
        Canvas.Line -Step(Dist, Dist)
        SierpC level - 1, Dist
        Canvas.Line -Step(0, Dist)
        SierpA level - 1, Dist
        Canvas.Line -Step(-Dist, Dist)
        SierpB level - 1, Dist
    End If
End Sub
' ************************************************
' Draw a type C sierpinski sub-curve.
' ************************************************
Sub SierpC(level As Integer, Dist As Single)
    If level = 1 Then
        Canvas.Line -Step(Dist, -Dist)
        Canvas.Line -Step(Dist, 0)
        Canvas.Line -Step(Dist, Dist)
    Else
        SierpC level - 1, Dist
        Canvas.Line -Step(Dist, -Dist)
        SierpD level - 1, Dist
        Canvas.Line -Step(Dist, 0)
        SierpB level - 1, Dist
        Canvas.Line -Step(Dist, Dist)
        SierpC level - 1, Dist
    End If
End Sub
' ************************************************
' Draw a type D sierpinski sub-curve.
' ************************************************
Sub SierpD(level As Integer, Dist As Single)
    If level = 1 Then
        Canvas.Line -Step(-Dist, -Dist)
        Canvas.Line -Step(0, -Dist)
        Canvas.Line -Step(Dist, -Dist)
    Else
        SierpD level - 1, Dist
        Canvas.Line -Step(-Dist, -Dist)
        SierpA level - 1, Dist
        Canvas.Line -Step(0, -Dist)
        SierpC level - 1, Dist
        Canvas.Line -Step(Dist, -Dist)
        SierpD level - 1, Dist
    End If
End Sub
' ************************************************
' Draw a type A sierpinski sub-curve.
' ************************************************
Sub SierpA(level As Integer, Dist As Single)
    If level = 1 Then
        Canvas.Line -Step(-Dist, Dist)
        Canvas.Line -Step(-Dist, 0)
        Canvas.Line -Step(-Dist, -Dist)
    Else
        SierpA level - 1, Dist
        Canvas.Line -Step(-Dist, Dist)
        SierpB level - 1, Dist
        Canvas.Line -Step(-Dist, 0)
        SierpD level - 1, Dist
        Canvas.Line -Step(-Dist, -Dist)
        SierpA level - 1, Dist
    End If
End Sub
Sub GetParameters()
    If Not IsNumeric(LevelText.Text) Then _
        LevelText.Text = "5"
    TheLevel = CInt(LevelText.Text)
    ' Compute the side length for this level.
    StartLength = TotalLength / (3 * 2 ^ TheLevel - 1)
    ' Compute the upper left corner.
    StartX = (Canvas.ScaleWidth - TotalLength) / 2
    StartY = (Canvas.ScaleHeight - TotalLength) / 2 + _
        StartLength
End Sub
Private Sub CmdGo_Click()
Dim i As Integer
    MousePointer = vbHourglass
    DoEvents
    ' Get the parameters.
    GetParameters
    ' Draw the curve.
    Canvas.Cls
    Canvas.CurrentX = StartX
    Canvas.CurrentY = StartY
    Sierpinski TheLevel, StartLength
    MousePointer = vbDefault
End Sub
Private Sub Form_Resize()
    Canvas.Move Canvas.Left, 0, _
        ScaleWidth - Canvas.Left, ScaleHeight - 1
    ' See how big we can make the curve.
    If Canvas.ScaleHeight < Canvas.ScaleWidth Then
        TotalLength = 0.9 * Canvas.ScaleHeight
    Else
        TotalLength = 0.9 * Canvas.ScaleWidth
    End If
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub